home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / print / pps213.zip / PPS213.PAS < prev   
Pascal/Delphi Source File  |  1990-02-08  |  32KB  |  968 lines
  1. {$R-}    {Range checking off}
  2. {$B+}    {Boolean complete evaluation on}
  3. {$S+}    {Stack checking on}
  4. {$I+}    {I/O checking on}
  5. {$N+,E+}    {numeric coprocessor - or emulation}
  6. {$M 65500,16384,655360} {Turbo 3 default stack and heap}
  7.  
  8. PROGRAM Postscript;
  9.  
  10.  
  11. {ASCII menu driven listing program that generates PostScript
  12. commands to the Apple LaserWriter.  Allows selction of
  13. bold and normal fonts, font size and line spacing.  Output
  14. can go to a disk file (output.ps) or directly to the printer.
  15.  
  16. Limitations: Handling tabs is limited to move to an absolute location
  17. on the line.  Program is not smart about the actual widths of
  18. characters in different fonts... it just uses an average width per
  19. character of fontsize/2.  Epson font change escapes ESC G for bold
  20. and ESC H for normal are used.  Spacing for a tab is based on an
  21. average of 8 nominal characters... as a result the tab spacing after
  22. some text with capital letters may not be wide enough and the text
  23. starting after the tab may overlap with previous text.  (On the other
  24. hand, the worst case width of 8 widest characters is too large for
  25. normal use).
  26.  
  27. Can be invoked with filename as a parameter: nlist filename
  28.  
  29. Free for non-commercial use only.
  30.  
  31. (C) Copywrite Nate Liskov 27 Jan 1986}
  32.  
  33. { Version 1.0 - Original Version 
  34. Version 1.1 - Fonts for LaserWriter Plus Added 
  35. Version 1.2 - Landscape Format Option Added - Apr 1987 
  36. version 1.21 - command line paramters -n= and -b= added to
  37.                  preset normal and bold fonts
  38.                - no headers, no lineffed and output to file are defaults
  39.                  if command line file has .mem extension
  40. version 1.22 - mar 1988
  41.                - option for number of lines added
  42.                - fix display of pages printed when page feed off
  43.                - capability to print multiple files per invocation added
  44.                - apr 88... fix spelling of avantgarde
  45. version 1.23  - apr 1988
  46.                - zeroize output.ps option added
  47. version 2.00  - converted to turbo 4.0
  48. version 2.02  - july 1988
  49.             - minor bugs corrected
  50. version 2.03  - 9 sept 1988
  51.            - correct bug in bold that inserted 2 spaces
  52. version 2.04  - 22 sept 1988
  53.            - leave leading blanks in each line vs removing them
  54.                thus correcting spacing problems with courier font
  55.            - reduce min left hand margin  from 45/72 to 36/72 inch
  56.            - appears to handle mix of tabs, bold, normal on one line
  57.            - tab spacing is 8 times a number character width
  58.                     note: for all fonts except courier number width =
  59.                            twice space width
  60. version 2.05  - change spacing for automatic centering
  61. version 2.06  - cleanup of 2.05, display of pitch
  62. version 2.07  - redirect output code changed, change mto to m
  63.            - conform to encapsulated postscript
  64. version 2.08  - converted to turbo 5.0, uses turbo3 dropped
  65. version 2.09  - account for actual space widths in breaking up long
  66.            - line into several lines
  67.            - 28 nov 1988 corrected bug with blank input lines
  68. version 2.10  - 12 dec 1988
  69.            - help function added with ? or help command line parameters
  70.            - 6 dec 1989
  71.            - debugged encapsulated postscript input to wordperfect 5.0
  72. version 2.11  - 24 dec 1988
  73.            - add helvetica-condensed fonts
  74.              (ti-omnilaser equivalent to helvetica narrow)
  75.            - 7 dec 1989
  76.            - debugged encapsulated postscript input to wordperfect
  77. version 2.12   - better file handling if input file does not exist
  78. }
  79.  
  80. Uses
  81.   Crt,
  82.   Dos,
  83.   Printer;
  84.  
  85. TYPE 
  86.   DateTimeStr = STRING[26];
  87.   OnorOff     = ARRAY[1..2] OF STRING[3];
  88.   pageform    = ARRAY[1..2] OF STRING[9];
  89.   fonttype    = ARRAY[1..37] OF STRING[28];
  90.   outfile     = ARRAY[1..2] OF STRING[21];
  91.   msg         = STRING[127];
  92.   maxspaces   = STRING[255];
  93.  
  94. VAR
  95.     numberofcopies, linecount, n, m, page, linelength, entryline : integer;
  96.     topspaces, bottomspaces, leftmargin, rightmargin, lm, rm : integer;
  97.     option   : char;
  98.     pagestr  : STRING[3];
  99.     filename : STRING[45];
  100.     temp, lineout     : STRING[255];
  101.     right, left : maxspaces;
  102.     source, sink   : text;
  103.     linesize, header, automatic, maxline : integer;
  104.     x,strng        : msg;
  105.     hellfreezesover,autoexit: boolean;
  106.     datetimestamp: datetimestr;
  107.     yposition,linesperpage,linespacing,nfont,bfont,currentfont,
  108.         nout,pagefeed,fontsize,pagetype : integer;
  109.     fontsused:array[1..37]of boolean;
  110.     formatsused:array[1..2]of boolean;
  111.  
  112.   CONST 
  113.     onoff: onoroff = ('On ','Off');
  114.     pageformat: pageform = ('Portrait ','Landscape');
  115.     font: fonttype = ('Helvetica','Times-Roman','Courier',
  116.                       'Helvetica-Oblique','Times-Italic','Courier-Oblique',
  117.                       'Helvetica-Bold','Times-Bold','Courier-Bold',
  118.                       'Helvetica-BoldOblique','Times-BoldItalic',
  119.               'Courier-BoldOblique','AvantGarde-Book',
  120.               'AvantGarde-BookOblique','AvantGarde-Demi',
  121.               'AvantGarde-DemiOblique','Bookman-Demi',
  122.               'Bookman-DemiItalic','Bookman-Light',
  123.               'Bookman-LightItalic','Helvetica-Narrow',
  124.               'Helvetica-Narrow-Bold',
  125.               'Helvetica-Narrow-Oblique',
  126.               'Helvetica-Narrow-BoldOblique',
  127.               'NewCenturySchlbk-Roman',
  128.               'NewCenturySchlbk-Bold','NewCenturySchlbk-Italic',
  129.               'NewCenturySchlbk-BoldItalic','Palatino-Roman',
  130.               'Palatino-Bold','Palatino-Italic','Palatino-BoldItalic',
  131.               'ZapfChancery-MediumItalic','Helvetica-Condensed',
  132.               'Helvetica-Condensed-Bold',
  133.               'Helvetica-Condensed-Oblique',
  134.               'Helvetica-Condensed-BoldObl');
  135.     spacewidth: ARRAY [1..37] of real = (0.556,0.5,0.6,0.556,0.5,0.6,
  136.                        0.556,0.5,0.6,0.556,0.5,0.6,
  137.                0.554,0.554,0.554,0.554,0.660,0.660,0.660,0.66,
  138.                0.456,0.456,0.456,0.456,0.556,0.556,0.556,0.556,
  139.                0.5,0.5,0.5,0.5,0.44,0.456,0.456,0.456,0.456);
  140.                {spacewidth is width of space for courier, else
  141.                 spacewidth is twice width of space which is 
  142.             same as the width of a number character}
  143.     output: outfile = ('Printer','Disk File: Output.ps');
  144.  
  145. function upword(wrd:msg):msg;
  146. var n:integer;
  147. begin
  148.   for n :=1 to length(wrd) do
  149.   wrd[n]:=upcase(wrd[n]);
  150.   upword := wrd;
  151. end;
  152.  
  153. FUNCTION spaces(n:integer): maxspaces;
  154.  
  155.   VAR 
  156.     tmp: STRING[255];
  157.     m: integer;
  158.   BEGIN
  159.     tmp := '';
  160.     FOR m :=1 TO n DO
  161.       tmp := tmp + ' ';
  162.     spaces := tmp;
  163.   END;
  164.  
  165. procedure setlinesize;
  166. begin
  167.     IF pagetype = 1 THEN linesize := round(594/(fontsize*spacewidth[nfont]))
  168.     ELSE linesize := round(774/(fontsize*spacewidth[nfont]));
  169.     if nfont in [3,6,9,12] then 
  170.           linesize:=linesize else
  171.           linesize:=round(linesize*1.04);    {fudge factor}
  172. end;
  173.  
  174. Procedure help;
  175. var foo :char;
  176. begin
  177.   clrscr;
  178.   writeln('                       PPS HELP');
  179.   writeln;
  180.   writeln('  Command Line Parameters');
  181.   writeln;
  182.   writeln('     ?, help       help on command line parameters');
  183.   writeln('     -0=10         sets fontsize to 10');
  184.   writeln('     -1=13         sets line spacing to 13');
  185.   writeln('     -2            pagefeed commands are in input file (default for .mem file)');
  186.   writeln('     -3=25         normal font is font 25');
  187.   writeln('     -4=13         bold font is font 13');
  188.   writeln('     -5=2          suppress header line (default for .mem file)');
  189.   writeln('     -6            output to printer vs output.ps');
  190.   writeln('     -7=5          topspaces = 5');
  191.   writeln('     -8=7          bottomspaces = 7');
  192.   writeln('     -9            automatic margins');
  193.   writeln('     -G            go, then exit program');
  194.   writeln('     -L=12         left margin is 12');
  195.   writeln('     -N=7          normal font is font 7');
  196.   writeln('     -P            landscape page format');
  197.   writeln('     -R=12         right margin is 12');
  198.   writeln('     -foobar       input file is foobar');
  199.   halt;
  200. end;
  201.  
  202. PROCEDURE Alarm;
  203. BEGIN
  204.   sound(1000);
  205.   delay(500);
  206.   nosound;
  207. END;
  208.  
  209. PROCEDURE Testfile(filename:msg);
  210. var
  211. fileok:boolean;
  212. BEGIN
  213.   {$I-}
  214.   Reset(s